package Zim::Page::Text;

use strict;
use Zim::Page;
#use Fcntl ':flock'; # import LOCK_* constants

our $VERSION = '0.17';

our @ISA = qw/Zim::Page/;

our %Formats = ( # maps names to modules
	wiki => 'Wiki',
	html => 'Html',
	pod  => 'Pod',
);
our %_Formats; # hash modules that are loaded already

=head1 NAME

Zim::Page::Text - Page object for Zim

=head1 DESCRIPTION

This class defines a page object that represents a text buffer.
This can either be a plain text or a formatted text (rich text).

The interfaces supported by this class are "source" and "formatted".
An individual object can have one of these or both.

The source interface uses C<IO::*> objects and requires the
repository to support an interface for opening and closing these objects.

The formatted interface uses parse trees to represent the logical
structure of the text. If a formatted text also has a source, a 
formatter object (C<Zim::Formats::*>) is used to parse the source.

=head1 METHODS

=over 4

=item C<interfaces()>

Returns a list of interfaces supported by this page.

=cut

sub interfaces {
	my $self = shift;
	return ( ($self->{format} ? 'formatted' : ()),
	         ($self->{source} ? 'source'    : ())  );
}

=item C<clone(PAGE)>

Import content from object PAGE into this object using the first
common interface found.

=cut

sub clone {
	my ($self, $page, %opt) = @_;
	local $self->{cloning} = $page;
	if (	$self->has_interface('formatted') and
		$page->has_interface('formatted')
	) {
		my $tree = $page->get_parse_tree;
		$self->_check_media($tree, $opt{media}, $page->properties->{base})
			if $opt{media} and $opt{media} ne 'relative';
		$self->set_parse_tree($tree);
	}
	elsif (	$self->has_interface('source') and
		$page->has_interface('source')
	) {
		$self->set_source($page->get_source);
		$self->{format} = undef;
	}
	else { warn "Could not clone page: ". $page->name ."\n" }
}

sub _check_media {
	my ($self, $tree, $media, $base) = @_;
	
	for my $i (2 .. $#$tree) {
		next unless ref $$tree[$i];
		if ($$tree[$i][0] eq 'link') {
			my ($type, $link) = $self->parse_link($$tree[$i][1]{to});
			next unless $type eq 'file';
			if ($media eq 'absolute') {
				$link = Zim::File->abs_path($link, $base);
				$$tree[$i][1]{to} = $link;
			}
			else { # 'copy'
				# TODO TODO
			}
		}
		elsif ($$tree[$i][0] eq 'image') {
			my $file = $$tree[$i][1]{src};
			if ($media eq 'absolute') {
				$file = Zim::File->abs_path($file, $base);
				$$tree[$i][1]{src} = $file;
			}
			else { # 'copy'
				# TODO TODO
			}
		}
		else { $self->_check_media($$tree[$i], $media, $base) }
	}
}

=back

=head2 Source Interface

=over 4

=item C<set_source(SOURCE)>

SOURCE is a scalar used to fetch a C<IO::*> object from the
repository later. This can for example be a filename but also
a complex structure containing all the parameters needed to
open an IO object.

This method should only be used by the repository. The GUI is not
allowed to know anything about the real source of pages, it can only
use the IO objects resulting from C<get_source(MODE)>.

This method sets the 'read_only' property to FALSE.

=cut

sub set_source {
	$_[0]->{source} = $_[1];
	$_[0]->{parse_tree} = undef;
	$_[0]->{properties}{read_only} = 0;
}

=item C<get_source(MODE)>

Returns an IO object or undef when there is none.
This method dies when it fails opening a given source.
In general pages that have status "new" will not yet have a source.

MODE is optional and can either be 'r' or 'w' depending on whether you
would like the source to be opened for reading or for writing.

Do not forget to close the IO object when you are done with it !

( When using source the repository should also support the
C<get_source(SOURCE, MODE)> method. )

=cut

sub get_source {
	my ($self, $mode) = @_;
	return unless defined $self->{source};
	$self->{status} = '' if $mode eq 'w'; # remove "new" or "deleted"
	return $self->{repository}->get_source($self->{source}, $mode);
}

=back

=head2 Formatted Interface

=over 4

=item C<set_format(FORMAT)>

Sets a source format for this page. This can either be an object of the class
L<Zim::Formats> (or similar), or a name in which case this will be looked up
in the C<Zim::Formats::*> namespace.

Formats are only used for pages that also have a source object.

=cut

sub set_format {
	my ($self, $format) = @_;
	$self->{format} = ref($format) ? $format : _load_format($format);
}

sub _load_format {
	my $name = shift;
	return $_Formats{$name} if defined $_Formats{$name};

	my $class = $Formats{$name} or die "Could not find a module for format '$name'\n";
	$class = 'Zim::Formats::'.$class unless $class =~ /::/;
	eval "use $class";
	die if $@;

	$_Formats{$name} = $class;
	return $class;
}

=item C<get_parse_tree()>

Get the parse tree for this page.

When using source this method will return the tree resulting from running
the given source through the given formatter.

=cut

sub get_parse_tree {
	my $self = shift;
	return $self->{parse_tree} if defined $self->{parse_tree};
	return unless defined $self->{source} and defined $self->{format};
	
	my $io = $self->get_source('r');
	if ($io) {
		my $tree = $self->{format}->load_tree($io, $self);
		$io->close;
		$tree->[1] = { %{$self->{properties}}, %{$tree->[1]} };
		return $tree;
	}
	else { return ['Document', $self->{properties}] }
}

=item C<set_parse_tree(TREE)>

Set the parse tree for this page.

When using source this method will use the formatter to save the parse tree
to the IO object.

=cut

sub set_parse_tree { #warn "set_parse_tree from ", join(' ', caller), "\n" ;
	my ($self, $tree) = @_;
	$self->{status} = ''; # remove "new" or "deleted"
	$self->{_links} = [ $self->_list_links($tree) ];
	if (defined $self->{source}) {
		my $io = $self->get_source('w')
			|| die "Could not save parse tree, did not get an IO object.\n";
		#flock($io, LOCK_EX); # lock # Move function to IO::File::Zim
		$self->{format}->save_tree($io, $tree, $self);
		#flock($io, LOCK_UN); # unlock
		$io->close;
		
		$self->{repository}->_cache_page($self)
			if $self->{repository}->can('_cache_page');
		# FIXME this hook does not belong here
	}
	else {
		$self->{parse_tree} = $tree;
	}
}

sub _list_links { #warn "_list_links from ", join(' ', caller), "\n" ;
	my $self = shift;
	my $node = shift;
	unless ($node) {
		return @{$self->{_links}} if $self->{_links};
		$node = $self->get_parse_tree;
	}

	my %links;
	for (2 .. $#$node) {
		my $n = $$node[$_];
		next unless ref $n;
		if ($$n[0] eq 'link') {
			my ($type, $link) = ('', $$n[1]{to});
			($type, $link) = $self->parse_link($link);
			next unless $type eq 'page';
			unless (defined $self->{_resolv}{$link}) {
				#warn "resolve link: $link\n";
				my $obj = $self->resolve_link($link);
				next unless $obj;
				$self->{_resolv}{$link} = $obj->name;
			}
			$link = $self->{_resolv}{$link};
			$links{$link} = 1;
		}
		else {
			%links = (%links, map {$_ => 1} _list_links($self, $n)); # recurse
		}
	}

	return keys %links;
}

sub _list_backlinks { # 'cloning' hack needed when exporting
	my $obj = $_[0]->{cloning} ? $_[0]->{cloning} : $_[0];
	return $obj->{repository}->can('_list_backlinks')
		? $obj->{repository}->_list_backlinks($obj)
		: () ;
}

sub _update_links {
	# FIXME ugly resolve lookup to be sure bout links
	# should implement a "compare" function for page names
	# end use the old object to compare links against
	my ($self, $type, $old, $new) = @_;
	return unless $self->{format};
	warn "Updating links in ", $self->name, "\n";
	my $tree = $self->get_parse_tree;
	my $done = 0;
	for my $ref (_extract('link', $tree)) {
		my ($t, $l) = $self->parse_link($$ref[1]{to});
		next unless $t eq $type;
		$l = $self->resolve_link($l) || next;
		$l = $l->name;
		warn "Matching $l to $old\n";
		next unless $l eq $old;
		$old = $$ref[1]{to};
		warn "Updating $old => $new\n";
		$$ref[1]{to} = $new->name;
		$$ref[2] = $$ref[1]{to} if $$ref[2] eq $old;
		$done++;
	}
	use Data::Dumper; warn Dumper $tree;
	$self->set_parse_tree($tree) if $done;
	warn "Updated $done links\n";
}

sub _extract {
	my ($type, $tree) = @_;
	my @nodes;
	for (2 .. $#$tree) {
		my $node = $$tree[$_];
		next unless ref $node;
		push @nodes, ($$node[0] eq $type)
			? $node : _extract($type, $node) ; # recurs
	}
	return grep defined($_), @nodes;
}

1;

__END__

=back

=head1 AUTHOR

Jaap Karssenberg (Pardus) E<lt>pardus@cpan.orgE<gt>

Copyright (c) 2005 Jaap G Karssenberg. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Zim>,
L<Zim::Page>,
L<Zim::Formats>,
L<Zim::Repository>

=cut
